home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung / Power-Programmierung CD 2 (Tewi)(1994).iso / doc / graphdoc / table.pas < prev    next >
Pascal/Delphi Source File  |  1993-11-05  |  7KB  |  258 lines
  1.  
  2. type
  3.   mmods=(_text,
  4.          _text2,
  5.          _text4,
  6.          _pl2 ,   {plain mono, 8 pixels per byte}
  7.          _pl2e,   {mono odd/even, 8 pixels per byte, two planes}
  8.          _herc,   {Hercules mono, 4 "banks" of 8kbytes}
  9.          _cga2,   {CGA 2 color, 2 "banks" of 16kbytes}
  10.          _cga4,   {CGA 4 color, 2 "banks" of 16kbytes}
  11.          _pl4 ,   {4 color odd/even planes}
  12.          _pk4 ,   {4 color "packed" pixels 4 pixels per byte}
  13.          _pl16,   {std EGA/VGA 16 color: 4 planes, 8 pixels per byte}
  14.          _pk16,   {ATI mode 65h two 16 color pixels per byte}
  15.          _p256,   {one 256 color pixel per byte}
  16.          _p32k,   {Sierra 15 bit}
  17.          _p64k,   {Sierra 16bit/XGA}
  18.          _p16m);  {RGB 3bytes per pixel}
  19.  
  20.   modetype=record
  21.              md,xres,yres,bytes:word;
  22.              memmode:mmods;
  23.            end;
  24.  
  25.   CHIPS=(__EGA,__VGA,__chips451,__chips452,__chips453,__paradise,__video7
  26.         ,__tseng3,__tseng4,__tridBR,__tridCS,__trid89,__everex,__ati1,__ati2
  27.         ,__genoa,__oak,__cirrus,__aheadA,__aheadB,__ncr,__yamaha,__poach
  28.         ,__s3,__al2101,__acumos,__mxic,__vesa,__realtek,__p2000,__cirrus54
  29.         ,__xga,__none);
  30.  
  31.  
  32. const
  33.   colbits:array[mmods] of integer=
  34.                (0,0,0,1,1,1,1,2,2,2,4,4,8,15,16,24);
  35.   modecols:array[mmods] of longint=
  36.                (0,0,0,2,2,2,2,4,4,4,16,16,256,32768,65536,16777216);
  37.  
  38.  
  39.   coltxt:array[mmods] of string[3]=('1','1','1','2','2','2','2'
  40.              ,'4','4','4','16','16','256','32k','64k','16m');
  41.  
  42.  
  43.   mdtxt:array[mmods] of string[210]=('Text','2 color Text','4 color Text'
  44.                 ,'Monochrome','2 colors planar','Hercules','CGA 2 color','CGA 4 color'
  45.                 ,'4 colors planar','4 colors packed','16 colors planar','16 colors packed'
  46.                 ,'256 colors packed','32768 colors','65536 colors'
  47.                 ,'16777216 colors');
  48.  
  49.   mmodenames:array[mmods] of string[4]=('TXT ','TXT2','TXT4','PL2 ','PL2E','HERC'
  50.               ,'CGA2','CGA4','PL4 ','PK4 ','PL16','PK16','P256','P32K','P64K','P16M');
  51.  
  52.  
  53.   header:array[CHIPS] of string[14]=
  54.          ('EGA','VGA','Chips&Tech','Chips&Tech','Chips&Tech'
  55.          ,'Paradise','Video7','ET3000','ET4000'
  56.          ,'Trident','Trident','Trident','Everex','ATI','ATI'
  57.          ,'Genoa','Oak','Cirrus','Ahead','Ahead','NCR'
  58.          ,'Yamaha','Poach','S3','AL2101','Acumos','MXIC'
  59.          ,'VESA','Realtek','PRIMUS','Cirrus54','XGA','');
  60.  
  61.  
  62.  
  63.  
  64. type
  65.   regblk=record
  66.            base:word;
  67.            nbr:word;
  68.            x:array[0..255] of byte;
  69.          end;
  70.  
  71.  
  72.   regtype=record
  73.             chip:chips;
  74.             mmode:mmods;
  75.             mode,pixels,lins,bytes,tridold0d,tridold0e:word;
  76.             attregs:array[0..31] of byte;
  77.             seqregs,grcregs,crtcregs,xxregs:regblk;
  78.             stdregs:array[$3c0..$3df] of byte;
  79.             xgaregs:array[0..15] of byte;
  80.           end;
  81.  
  82.  
  83. var
  84.   f:file of regtype;
  85.   fo:text;
  86.   s:string;
  87.  
  88.   xxs,ix,off:word;
  89.   mxcrtc,mxseq,mxattr,mxgrf,mxxtra,xtraix:word;
  90.   xx:array[1..50] of regtype;
  91.  
  92. const hx:array[0..15] of char='0123456789ABCDEF';
  93.  
  94. function hex2(w:word):string;
  95. begin
  96.   hex2:=hx[(w shr 4) and 15]+hx[w and 15];
  97. end;
  98.  
  99. function hex4(w:word):string;
  100. begin
  101.   hex4:=hx[w shr 12]+hx[hi(w) and 15]+hx[(w shr 4) and 15]+hx[w and 15];
  102. end;
  103.  
  104. function gtbyte(var s:string):word;
  105. var i,j:word;
  106. begin
  107.   while copy(s,1,1)=' ' do delete(s,1,1);
  108.   i:=(ord(s[1])-48) and 31;if i>9 then dec(i,7);
  109.   j:=(ord(s[2])-48) and 31;if j>9 then dec(j,7);
  110.   delete(s,1,2);
  111.   gtbyte:=i*16+j;
  112. end;
  113.  
  114. function gtword(var s:string):word;
  115. var i,j:word;
  116. begin
  117.   i:=gtbyte(s);
  118.   j:=gtbyte(s);
  119.   gtword:=i*256+j;
  120. end;
  121.  
  122. function gtval(var s:string):longint;
  123. var x,z:word;
  124.   y:longint;
  125. begin
  126.   x:=pos(': ',s);
  127.   delete(s,1,x+1);
  128.   x:=pos(' ',s);if x=0 then x:=length(s)+1;
  129.   val(copy(s,1,x-1),y,z);
  130.   delete(s,1,x);
  131.   gtval:=y;
  132. end;
  133.  
  134.  
  135. var
  136.   parms:word;
  137.   parm:array[1..256] of word;
  138.   parmsame:boolean;
  139.   parmstr:string;
  140.  
  141. procedure setstr(s:string);
  142. begin
  143.   parms:=0;
  144.   parmstr:=s;
  145.   parmsame:=true;
  146. end;
  147.  
  148. procedure adds(w:word);
  149. begin
  150.   inc(parms);
  151.   parm[parms]:=w;
  152.   if parm[1]<>w then parmsame:=false;
  153. end;
  154.  
  155. function getstr:string;
  156. var x:word;
  157. begin
  158.   if parmsame then parms:=1;
  159.   for x:=1 to parms do
  160.     parmstr:=parmstr+' '+hex4(parm[x]);
  161.   getstr:=parmstr;
  162. end;
  163.  
  164.  
  165. var x,y:word;
  166.     l:longint;
  167.  
  168. begin
  169.   assign(f,'register.vga');
  170.   reset(f);
  171.   xxs:=0;ix:=0;off:=0;xtraix:=0;
  172.   mxcrtc:=0;mxattr:=31;mxseq:=0;mxgrf:=0;mxxtra:=0;
  173.   fillchar(xx,sizeof(xx),0);
  174.   while not eof(f) do
  175.   begin
  176.     inc(xxs);
  177.     read(f,xx[xxs]);
  178.     if xx[xxs].seqregs.nbr>mxseq then mxseq:=xx[xxs].seqregs.nbr;
  179.     if xx[xxs].grcregs.nbr>mxgrf then mxgrf:=xx[xxs].grcregs.nbr;
  180.     if xx[xxs].crtcregs.nbr>mxcrtc then mxcrtc:=xx[xxs].crtcregs.nbr;
  181.     if xx[xxs].xxregs.base<>0 then
  182.     begin
  183.       xtraix:=xx[xxs].xxregs.base;
  184.       if xx[xxs].xxregs.nbr>mxxtra then mxxtra:=xx[xxs].xxregs.nbr;
  185.     end;
  186.   end;
  187.   close(f);
  188.  
  189.   assign(fo,'register.tbl');
  190.   rewrite(fo);
  191.   write(fo,'Mode:   ');
  192.   for y:=1 to xxs do write(fo,hex4(xx[y].mode):5);
  193.   writeln(fo);
  194.   write(fo,'Pixels: ');
  195.   for y:=1 to xxs do write(fo,xx[y].pixels:5);
  196.   writeln(fo);
  197.   write(fo,'Lines:  ');
  198.   for y:=1 to xxs do write(fo,xx[y].lins:5);
  199.   writeln(fo);
  200.   write(fo,'Bytes:  ');
  201.   for y:=1 to xxs do write(fo,xx[y].bytes:5);
  202.   writeln(fo);
  203.   write(fo,'Colors: ');
  204.   for y:=1 to xxs do write(fo,coltxt[xx[y].mmode]:5);
  205.   writeln(fo);
  206.   if xx[1].chip in [__tridBR,__tridCS,__trid89,__poach] then
  207.   begin
  208.     setstr('OLD 0D: ');
  209.     for y:=1 to xxs do adds(xx[y].tridold0d);
  210.     writeln(fo,getstr);
  211.     setstr('OLD 0E: ');
  212.     for y:=1 to xxs do adds(xx[y].tridold0E);
  213.     writeln(fo,getstr);
  214.   end;
  215.  
  216.   setstr('03CC   :');
  217.   for y:=1 to xxs do adds(xx[y].stdregs[$3CC]);
  218.   writeln(fo,getstr);
  219.   setstr('03DA   :');
  220.   for y:=1 to xxs do adds(xx[y].stdregs[$3DA]);
  221.   writeln(fo,getstr);
  222.  
  223.  
  224.   for x:=0 to mxattr do
  225.   begin
  226.     setstr('ATTR '+hex2(x)+':');
  227.     for y:=1 to xxs do adds(xx[y].attregs[x]);
  228.     writeln(fo,getstr);
  229.   end;
  230.   for x:=0 to mxSEQ do
  231.   begin
  232.     setstr('SEQ '+hex2(x)+': ');
  233.     for y:=1 to xxs do adds(xx[y].seqregs.x[x]);
  234.     writeln(fo,getstr);
  235.   end;
  236.   for x:=0 to mxgrf do
  237.   begin
  238.     setstr('GRF '+hex2(x)+': ');
  239.     for y:=1 to xxs do adds(xx[y].grcregs.x[x]);
  240.     writeln(fo,getstr);
  241.   end;
  242.   for x:=0 to mxcrtc do
  243.   begin
  244.     setstr('CRTC '+hex2(x)+':');
  245.     for y:=1 to xxs do adds(xx[y].crtcregs.x[x]);
  246.     writeln(fo,getstr);
  247.   end;
  248.   if xtraix<>0 then
  249.     for x:=0 to mxxtra do
  250.     begin
  251.       setstr(hex4(xtraix)+' '+hex2(x)+':');
  252.       for y:=1 to xxs do adds(xx[y].xxregs.x[x]);
  253.       writeln(fo,getstr);
  254.     end;
  255.   close(fo);
  256. end.
  257.  
  258.